home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0163_Snow fall graphic.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-03  |  3KB  |  93 lines
  1.  
  2. {you've seen it before, but not this fast... :-) }
  3. (********************************************************************
  4.  Originally idea  : Nick Batalas, ( dated    14-6-1994 )
  5.  Sourced from                   : Eric Coolman, ( modified 19-6-1994 )
  6.  Rewritten by                   : Wil Barath,              03-9-1994
  7.  new : assembly optimisation, random weaving, memory reduction, etc.
  8.  ********************************************************************)
  9. Program SnowFall;
  10. const
  11.   Flakes = 3000;     { higher = more flakes }
  12.   Fastest= 240;      { try smaller numbers for slower flakes}
  13.   Explosion = False; { False for no explosion }
  14. Var r:Word;
  15. {---------------- Stuff not specific to snowfall ----------------}
  16. Procedure vidMode(mode : byte);assembler;
  17.   asm mov ah,$00;  mov al,mode; int 10h; end;
  18. Function ReadKey:Char;Assembler;
  19. asm Mov ax,0000h; int 16h; end;
  20. Function Keypressed:Boolean;Assembler;
  21. asm Mov ax,0100h; int 16h; JNZ @1; Xor ax,ax; Ret;
  22. @1: Inc ax; end;
  23. Procedure Perturb;assembler;  {Peturbation algorhythm (C) 1982 BarathSoft}
  24. asm Mov dx,r; Xor dx,0aa55h; SHL dx,1; Adc dx,$118; Mov r,dx; end;
  25. {---------------------------MAIN PROGRAM-------------------------}
  26. Type FlakeyRec = Record x,y:Byte;p:Word; end;
  27. var  CurFlake,s,pf:Word;
  28.                  Flake:Array[0..flakes] of flakeyrec;
  29. Procedure Pascal_Version;
  30. Begin
  31.   repeat
  32.     for CurFlake:= 1 to flakes do with flake[curflake] do
  33.     begin
  34.       Perturb; Mem[$a000:p]:=0;
  35.       If x>=lo(r) then Inc(p);
  36.       If y>=Hi(r) then Inc(p,320);
  37.       Mem[$a000:p]:=y SHR 5 + $18;
  38.     end;
  39.     Repeat Until (port[$3da] and $08) = $08;  {wait for vRetrace }
  40.   until keypressed;
  41. end;
  42. Procedure Assembly_version;
  43. Begin
  44.   repeat              { * NOTE * the above pascal version was derived }
  45.        ASM            { from the assembly below, and is Very optimal. }
  46.           Mov dx,r
  47.           Mov cx,flakes             {for CurFlake:= 1 to flakes do}
  48.           Mov pf,Offset flake;      {with flake[curflake] do}
  49.           Mov ax,0a000h
  50.           Mov es,ax                 {begin}
  51.           Mov bx,$118
  52. @0:       Xor dx,0aa55h             {Perturb }
  53.           SHL dx,1
  54.           Adc dx,bx
  55.           Mov si,pf
  56.           Mov di,[si.FlakeyRec.p]
  57.           Xor al,al
  58.           Mov es:[di],al            {Mem[$a000:p]:=0;}
  59.           Cmp dl,[si.FlakeyRec.x]   {If x>=Lo(r) then Inc(p);}
  60.           Jnc @1
  61.           Inc di
  62. @1:       Mov ah,[si.FlakeyRec.y]
  63.           Cmp dh,ah                 {If y>=Hi(r) then Inc(p,320);}
  64.           Jnc @2
  65.           Add di,320
  66. @2:       Mov Word Ptr [si.FlakeyRec.p],di
  67.           Shr ah,5                  {Mem[$a000:p]:=y SHR 5 + $18;}
  68.           add ah,bl
  69.           Mov es:[di],ah
  70.           Add pf,Type flakeyRec
  71.           Loop @0
  72.           Mov r,dx
  73.         end;                        {end;}
  74.     Repeat Until (port[$3da] and $08) = $08;  { wait for vRetrace }
  75.   until keypressed;
  76. End;
  77. Begin
  78.   for CurFlake:=0 to Flakes do With Flake[curflake] do
  79.   begin                              { set up snow lookup table }
  80.     Perturb; Inc(s,r);
  81.     y:=Hi(Hi(r)*fastest)+5;
  82.     x:=Hi(Lo(r)*y)+1;                {limit x movement}
  83.     If explosion = False then p:=s;
  84.   end;
  85.   vidMode($13);                      { 320x200x256 graphics mode }
  86.   Repeat
  87.     Pascal_version;
  88.     If ReadKey=#27 then Break;
  89.     Assembly_version;
  90.   Until ReadKey=#27;
  91.   vidMode($03);                      { return to 80x25 textmode }
  92. end.
  93.